home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / pbwiz16.zip / XMSDEMO.BAS < prev   
BASIC Source File  |  1993-02-25  |  5KB  |  144 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |         PBWIZ  Copyright (c) 1991-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      PowerBASIC Wizard's Library                     |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9. '  This provides a brief demo of the XMS routines.  It allocates enough
  10. '  memory to hold a long integer array of dimensions 300 x 70 and loads
  11. '  it sequentially with long integers.  Why?  Because someone requested
  12. '  it, that's why!  Actually, they wanted 3003 x 70, which is nigh on to
  13. '  a megabyte, and considerably more than PowerBASIC can handle on its own.
  14. '  With these routines, 3003 x 70 is a snap, but I'm using a fraction of
  15. '  the size to keep things reasonably quick.  The technique used here can
  16. '  be used to simulate an array of any size, however.
  17.  
  18.    $DIM ARRAY
  19.  
  20.    DECLARE SUB XMSclose (INTEGER)
  21.    DECLARE FUNCTION XMSexists% ()
  22.    DECLARE FUNCTION XMSlfree& ()
  23.    DECLARE SUB XMSopen (LONG, INTEGER, INTEGER)
  24.    DECLARE SUB XMSread (INTEGER, LONG, LONG, INTEGER, INTEGER)
  25.    DECLARE SUB XMSwrite (INTEGER, LONG, LONG, INTEGER, INTEGER)
  26.  
  27.    $LINK "pbwiz.pbl"
  28.  
  29.    DEFINT A-Z
  30.  
  31.  
  32.  
  33.    ' -- Set up variables.  We'll be simulating a 300x70 element array of
  34.    ' -- long integers in XMS.  This would ordinarily look something like:
  35.    ' -- DIM BigArray&(300,70) with OPTION BASE 1 on.
  36.  
  37.    Size1& = 300&                       ' elements in first dimension
  38.    Size2& = 70&                        ' elements in second dimension
  39.    BytesPerElement& = 4                ' bytes per element
  40.  
  41.    ArrayBytes& = Size1& * Size2& * BytesPerElement&  ' bytes needed for array
  42.    ArrayKB& = (ArrayBytes& + 1023&) \ 1024&          ' Kbytes needed for array
  43.  
  44.  
  45.  
  46.    '-- Make sure XMS is installed and that there's enough of it.
  47.  
  48.    IF NOT XMSexists THEN
  49.       PRINT "This demo requires XMS memory to run."
  50.       END
  51.    END IF
  52.  
  53.    IF ArrayKB& > XMSlfree& THEN
  54.       PRINT "This demo requires more XMS memory than is available."
  55.       END
  56.    END IF
  57.  
  58.  
  59.  
  60.    '-- Open an area of XMS memory (like DIM for arrays).
  61.    '-- If it succeeds, it will return a value in ArrayName
  62.    '-- which we'll use to access the opened memory area.
  63.  
  64.    CALL XMSopen (ArrayKB&, ArrayName, ErrCode)
  65.    IF ErrCode THEN
  66.       PRINT "Error allocating XMS.  Unable to proceed."
  67.       END
  68.    END IF
  69.  
  70.    CLS
  71.    PRINT "XMS allocated for 300x70 long integer array.  Bytes ="; ArrayBytes&
  72.  
  73.  
  74.  
  75.    '-- Since we want the numbers we display to be right-justified, and
  76.    '-- PRINT USING would be overkill (also slow), we'll use RSET to do
  77.    '-- the work for us.  First, we need to define the string "fields".
  78.    '-- We'll make them just large enough for the largest number we'll
  79.    '-- display in each print position.
  80.  
  81.    First$ = SPACE$(LEN(STR$(Size1&)))
  82.    Second$ = SPACE$(LEN(STR$(Size2&)))
  83.    Third$ = SPACE$(LEN(STR$(Size1& * Size2&)))
  84.  
  85.  
  86.  
  87.    '-- Let's fill 'er up with sequential numbers starting from 1.
  88.    LOCATE 4, 1
  89.    PRINT "Filling XMS 'array' with sequential values..."
  90.    Counter& = 1&
  91.    ' get pointer to value to set
  92.    DSeg = VARSEG(Counter&)
  93.    DOfs = VARPTR(Counter&)
  94.    FOR FirstElement = 1 TO Size1&
  95.       RSET First$ = STR$(FirstElement)
  96.       FOR SecondElement = 1 TO Size2&
  97.          RSET Second$ = STR$(SecondElement)
  98.          RSET Third$ = STR$(Counter&)
  99.          LOCATE 5, 1
  100.          PRINT "Array&("; First$; ", "; Second$; ") = "; Third$;
  101.          ' calculate position within XMS memory
  102.          Posn& = (CLNG(FirstElement - 1) * Size2& + CLNG(SecondElement - 1)) * BytesPerElement&
  103.          ' set it
  104.          CALL XMSwrite (ArrayName, Posn&, BytesPerElement&, DSeg, DOfs)
  105.          ' update the counter
  106.          INCR Counter&
  107.       NEXT
  108.    NEXT
  109.  
  110.  
  111.  
  112.    '-- Let's read it back, by way of verification
  113.    LOCATE 7, 1
  114.    PRINT "Reading back from XMS 'array'..."
  115.    ' get pointer to value to read
  116.    DSeg = VARSEG(Counter&)
  117.    DOfs = VARPTR(Counter&)
  118.    FOR FirstElement = 1 TO Size1&
  119.       RSET First$ = STR$(FirstElement)
  120.       FOR SecondElement = 1 TO Size2&
  121.          RSET Second$ = STR$(SecondElement)
  122.          ' calculate position within XMS memory
  123.          Posn& = (CLNG(FirstElement - 1) * Size2& + CLNG(SecondElement - 1)) * BytesPerElement&
  124.          ' read it
  125.          CALL XMSread (ArrayName, Posn&, BytesPerElement&, DSeg, DOfs)
  126.          LOCATE 8, 1
  127.          RSET Third$ = STR$(Counter&)
  128.          PRINT "Array&("; First$; ", "; Second$; ") = "; Third$;
  129.       NEXT
  130.    NEXT
  131.  
  132.  
  133.  
  134.    '-- We're all done, so let's return the XMS memory to the system.
  135.    '-- This is IMPORTANT, because otherwise the XMS would remain
  136.    '-- unavailable until the computer is rebooted.
  137.  
  138.    CALL XMSclose (ArrayName)
  139.  
  140.  
  141.  
  142.    LOCATE 10, 1
  143.    PRINT "Done"
  144.